home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Book / stackgraph.lsp < prev   
Text File  |  1990-10-11  |  3KB  |  89 lines
  1. ; book pp.262-279
  2.  
  3. (require "data/stackloss")
  4.  
  5. (setf w (send graph-proto :new 4))
  6. (send w :variable-label '(0 1 2 3) (list "Air" "Temp." "Conc." "Loss"))
  7. (send w :add-points (list air temp conc loss))
  8. (send w :adjust-to-data)
  9.  
  10. (send w :add-lines (list air temp conc loss))
  11. (send w :x-axis t)
  12. (send w :y-axis t)
  13. (send w :range 1 16 28)
  14. (send w :y-axis t t 7)
  15.  
  16. (send w :current-variables 2 3)
  17. (send w :range 3 0 50)
  18. (send w :y-axis t t 6)
  19.  
  20. (send w :current-variables 0 1)
  21. (send w :x-axis nil)
  22. (send w :y-axis nil)
  23. (send w :scale-type 'variable)
  24.  
  25. (send w :transformation
  26.       '#2a((0 0 -1  0)
  27.            (0 0  0 -1)
  28.            (1 0  0  0)
  29.            (0 1  0  0)))
  30. (send w :transformation nil)
  31.  
  32. (let* ((c (cos (/ pi 20)))
  33.        (s (sin (/ pi 20)))
  34.        (m (+ (* c (identity-matrix 4))
  35.              (* s '#2a((0 0 -1  0)
  36.                        (0 0  0 -1)
  37.                        (1 0  0  0)
  38.                        (0 1  0  0))))))
  39.    (dotimes (i 10) (send w :apply-transformation m)))
  40. (send w :transformation nil)
  41.  
  42. (dotimes (i 10) (send w :rotate-2 0 2 (/ pi 20) :draw nil)
  43.                 (send w :rotate-2 1 3 (/ pi 20)))
  44. (send w :transformation nil)
  45.  
  46. (require "test/showcoord")
  47. (require "test/identifypoint")
  48. (require "test/pointmove")
  49.  
  50. ; book pp.287-289
  51.  
  52. (let ((h (+ (send w :text-ascent) (send w :text-descent))))
  53.   (send w :margin 0 (round (* 1.5 h)) 0 0))
  54. (setf interp-overlay (send graph-overlay-proto :new))
  55. (let* ((ascent (send w :text-ascent))
  56. ;       (descent (send w :text-descent))
  57.        (x ascent)
  58.        (y (round (* 1.5 ascent)))
  59.        (box ascent))
  60.   (send interp-overlay :add-slot 'location
  61.       (list x y box (round (+ x (* 1.5 box))))))
  62. (defmeth interp-overlay :location () (slot-value 'location))
  63. (defmeth interp-overlay :redraw ()
  64.   (let* ((loc (send self :location))
  65.          (x (first loc))
  66.          (y (second loc))
  67.          (box (third loc))
  68.          (string-x (fourth loc))
  69.          (graph (send self :graph)))
  70.      (send graph :frame-rect x (- y box) box box)
  71.      (send graph :draw-string "Interpolate" string-x y)))
  72. (defmeth interp-overlay :do-click (x y m1 m2)
  73.   (let* ((loc (send self :location))
  74.          (box (third loc))
  75.          (left (first loc))
  76.          (top (- (second loc) box))
  77.          (right (+ left box))
  78.          (bottom (+ top box))
  79.          (graph (send self :graph)))
  80.      (when (and (< left x right) (< top y bottom))
  81.            (send graph :interpolate)
  82.            t)))
  83. (defmeth w :interpolate ()
  84.   (send self :transformation nil)
  85.   (dotimes (i 10)
  86.            (send self :rotate-2 0 2 (/ pi 20) :draw nil)
  87.            (send self :rotate-2 1 3 (/ pi 20))))
  88. (send w :add-overlay interp-overlay)
  89.